perm filename BBCLT.LSP[206,LSP] blob
sn#307857 filedate 1977-10-25 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00041 ENDMK
C⊗;
(DEFPROP BBFCNS
(BBFCNS ALPHABETIC
ALPHANUM
BBARGS
BBCOND
BBELSE
BBEX
BBEXL
BBFUN
BBFUNCTION
BBFUNDEF
BBINIT
BBLAMBDA
BBLAMBDAF
BBLIST
BBLISTF
BBLSPPUB
BBMCLPUB
BBPPROP
BBPPROPS
BBPROG
BBPROGA
BBPROPS
BBQUOTE
BBQUOTEA
BBQUOTEL
BBSELECTA
BBSELECTQ
BBVALDEF
BBVARS
BINOPB
BRACKET
CHARW
CHVAL
CLEARBB
FIN
FSIZE
HIN
INOPB
INOPBB
INPUNA
LABL
LCASE
LINL
MAK
MAXF
NEWLINE
PARENS
PPLIST
PRA
PREH
PREX
PRF
PRINTC
PRINX
PRINXX
PRT
PSIZE
SETPRINTPROPS
SETCARLIST
SIMPLEPRINT
SIN
SMALL
SMALLNAM
SUMLEN
TTYMSG
ULINE
UNOP
XA
XBLANK
XBOLD
XCONST
XSPACE
XSYM
XVAR)
VALUE)
(DEFPROP ALPHABETIC
(LAMBDA (V) (AND (GREATERP V 100) (LESSP V 133)))
EXPR)
(DEFPROP ALPHANUM
(LAMBDA(U)
(OR (NULL U)
(AND (OR (NUMBERP (CAR U)) (ALPHABETIC (CHRVAL (CAR U))))
(ALPHANUM (CDR U)))))
EXPR)
(DEFPROP BBARGS
(LAMBDA (U) (MAPCAR (FUNCTION BBEX) U))
EXPR)
(DEFPROP BBCOND
(LAMBDA(U)
(CONS
12
(COND
((NULL U) (MAK (QUOTE X) (LIST (XVAR NIL))))
(T
(MAK
(QUOTE E)
(CONS
(MAK
(QUOTE T)
(LIST
(MAK
(QUOTE B)
(LIST (MAK (QUOTE X) (LIST (XBOLD (QUOTE if)) (XBLANK)))
(BRACKET (BBEX (CAAR U)) 12)))
(MAK
(QUOTE B)
(LIST
(MAK (QUOTE X)
(LIST (XBLANK) (XBOLD (QUOTE then)) (XBLANK)))
(BRACKET (BBEXL (CDAR U)) 12)))))
(BBELSE (CDR U))))))))
EXPR)
(DEFPROP BBELSE
(LAMBDA(U)
(COND
((NULL U) NIL)
((EQ (CAAR U) (QUOTE T))
(LIST
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X)
(LIST (XBLANK) (XBOLD (QUOTE else)) (XBLANK)))
(BRACKET (BBEXL (CDAR U)) 5)))))
(T
(CONS
(MAK (QUOTE T)
(LIST
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X)
(LIST (XBLANK)
(XBOLD (QUOTE else/ if))
(XBLANK)))
(BRACKET (BBEX (CAAR U)) 12)))
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X)
(LIST (XBLANK) (XBOLD (QUOTE then)) (XBLANK)))
(BRACKET (BBEXL (CDAR U)) 12)))))
(BBELSE (CDR U))))))
EXPR)
(DEFPROP BBEX
(LAMBDA(E)
(COND ((ATOM E) (CONS 144 (MAK (QUOTE X) (LIST (XVAR E)))))
((ATOM (CAR E))
((LAMBDA(U)
(COND ((NULL U) (BBFUN (CAR E) (BBARGS (CDR E))))
((NULL (CDR U)) ((CAR U) (CDR E)))
(T ((CAR U) (CDR E) (CDR U)))))
(GET (CAR E) (QUOTE CARBB))))
((EQ (CAAR E) (QUOTE LAMBDA))
(BBLAMBDA (CDAR E) (BBARGS (CDR E))))
(T (BBFUN (QUOTE APPLY$) (BBARGS E)))))
EXPR)
(DEFPROP BBEXL
(LAMBDA(U)
(COND ((NULL U) (BBEX (QUOTE ****)))
((NULL (CDR U)) (BBEX (CAR U)))
(T
(CONS 5
(MAK (QUOTE E)
(INPUNA
(MAK (QUOTE X) (LIST (XSYM (QUOTE /,/ ))))
(BBARGS U)))))))
EXPR)
(DEFPROP BBFUN
(LAMBDA(FN ARGS)
(CONS
132
(COND
((NULL ARGS)
(MAK (QUOTE X) (LIST (XVAR FN) (XSYM (QUOTE /[/])))))
((NULL (CDR ARGS))
(MAK
(QUOTE F)
(LIST (MAK (QUOTE X) (LIST (XVAR FN) (XBLANK))) (CDAR ARGS))))
(T
(MAK
(QUOTE F)
(LIST
(MAK (QUOTE X) (LIST (XVAR FN) (XSYM (QUOTE /[))))
(MAK
(QUOTE A)
(LIST
(MAK
(QUOTE E)
(INPUNA (MAK (QUOTE X) (LIST (XSYM (QUOTE /,/ )))) ARGS))
(MAK (QUOTE X) (LIST (XSYM (QUOTE /]))))))))))))
EXPR)
(DEFPROP BBFUNCTION
(LAMBDA (E) (BBEX (CAR E)))
EXPR)
(DEFPROP BBFUNDEF
(LAMBDA(NAME ARGS BODY PROP)
(MAK (QUOTE F)
(LIST (MAK (QUOTE A)
(LIST (CDR (BBFUN NAME (BBARGS ARGS)))
(MAK (QUOTE X)
(COND ((EQ PROP (QUOTE EXPR))
(LIST (XBLANK)
(XSYM (QUOTE ←/ ))))
(T
(LIST (XBLANK)
(XSYM (QUOTE /())
(XCONST (QUOTE FEXPR))
(XSYM
(QUOTE /)/ ←/ ))))))))
(BRACKET (BBEXL BODY) 5))))
EXPR)
(DEFPROP BBGO
(LAMBDA(E)
(CONS 144
(MAK (QUOTE F)
(LIST (MAK (QUOTE X) (LIST (XBOLD (QUOTE go/ ))))
(CDR (BBQUOTE E))))))
EXPR)
(DEFPROP BBINIT
(LAMBDA(L)
(COND
((OR (NULL (ERRSET BBNAME NIL)) (NULL BBNAME))
(NILL DSKIN)
(SETQ PRINTPROPS NIL)
(SETQ CARBBLIST NIL)
(SETQ PPROPLIST NIL)
(SETQ LCFONTS NIL)))
(SETQ BBNAME (CAR L))
(CLEARBB))
FEXPR)
(DEFPROP BBLAMBDA
(LAMBDA(U ARGS)
(CONS 144
(MAK (QUOTE T)
(LIST (PARENS (MAK (QUOTE X) (LIST (XSYM (QUOTE {))))
(MAK (QUOTE X) (LIST (XSYM (QUOTE }))))
ARGS)
(CDR (BBLAMBDAF U))))))
EXPR)
(DEFPROP BBLAMBDAF
(LAMBDA(U)
(CONS
144
(MAK (QUOTE F)
(LIST
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X) (LIST (XSYM (QUOTE /[λ))))
(MAK (QUOTE A)
(LIST
(BBVARS (CAR U))
(MAK (QUOTE X) (LIST (XSYM (QUOTE /:/ ))))))))
(MAK (QUOTE A)
(LIST (BRACKET (BBEXL (CDR U)) 5)
(MAK (QUOTE X) (LIST (XSYM (QUOTE /]))))))))))
EXPR)
(DEFPROP BBLIST
(BBLIST (CONS BINOPB 24 (BBSYM / ) (BBSYM /.) (BBSYM / ))
(APPEND BINOPB 12 (BBSYM / ) (BBSYM *) (BBSYM / ))
(COND BBCOND)
(QUOTE BBQUOTE)
(GO BBGO)
(OR BINOPB 24 (BBSYM / ) (BBSYM ∨) (BBSYM / ))
(AND BINOPB 24 (BBSYM / ) (BBSYM ∧/ ))
(LIST BBLISTF)
(LAMBDA BBLAMBDAF)
(FUNCTION BBFUNCTION)
(PLUS BINOPB 40 (BBSYM / ) (BBSYM +) (BBSYM / ))
(GREATERP BINOPB 30 (BBSYM / ) (BBSYM >) (BBSYM / ))
(LESSP BINOPB 30 (BBSYM / ) (BBSYM <) (BBSYM / ))
(PROG BBPROG)
(NULL UNOP 132 (BBBOLD n/ ))
(MINUS UNOP 132 (BBSYM -))
(CAR UNOP 132 (BBBOLD a/ ))
(CDR UNOP 132 (BBBOLD d/ ))
(CADR UNOP 132 (BBBOLD ad/ ))
(CDAR UNOP 132 (BBBOLD da/ ))
(CDDR UNOP 132 (BBBOLD dd/ ))
(CAAR UNOP 132 (BBBOLD aa/ ))
(CAAAR UNOP 132 (BBBOLD aaa/ ))
(CAADR UNOP 132 (BBBOLD aad/ ))
(CADAR UNOP 132 (BBBOLD ada/ ))
(CADDR UNOP 132 (BBBOLD add/ ))
(CDAAR UNOP 132 (BBBOLD daa/ ))
(CDADR UNOP 132 (BBBOLD dad/ ))
(CDDAR UNOP 132 (BBBOLD dda/ ))
(CDDDR UNOP 132 (BBBOLD ddd/ ))
(CAAAAR UNOP 132 (BBBOLD aaaa/ ))
(CAAADR UNOP 132 (BBBOLD aaad/ ))
(CAADAR UNOP 132 (BBBOLD aada/ ))
(CAADDR UNOP 132 (BBBOLD aadd/ ))
(CADAAR UNOP 132 (BBBOLD adaa/ ))
(CADADR UNOP 132 (BBBOLD adad/ ))
(CADDAR UNOP 132 (BBBOLD adda/ ))
(CADDDR UNOP 132 (BBBOLD addd/ ))
(CDAAAR UNOP 132 (BBBOLD daaa/ ))
(CDAADR UNOP 132 (BBBOLD daad/ ))
(CDADAR UNOP 132 (BBBOLD dada/ ))
(CDADDR UNOP 132 (BBBOLD dadd/ ))
(CDDAAR UNOP 132 (BBBOLD ddaa/ ))
(CDDADR UNOP 132 (BBBOLD ddad/ ))
(CDDDAR UNOP 132 (BBBOLD ddda/ ))
(CDDDDR UNOP 132 (BBBOLD dddd/ ))
(ATOM UNOP 132 (BBBOLD at/ ))
(EQ BINOPB 30 (BBSYM / ) (BBBOLD eq/ ))
(= BINOPB 30 (BBSYM / ) (BBBOLD =/ ))
(EQUAL BINOPB 30 (BBSYM / ) (BBBOLD equal/ ))
(MEMBER BINOPB 30 (BBSYM / ) (BBSYM ε/ ))
(NOT UNOP 132 (BBSYM ¬))
(DIFFERENCE BINOPB 40 (BBSYM / ) (BBSYM -/ ))
(SETQ BINOPB 20 (BBSYM / ) (BBSYM ←/ ))
(SELECTQ BBSELECTQ))
VALUE)
(DEFPROP BBLISTF
(LAMBDA(U)
(CONS 144
(PARENS (MAK (QUOTE X) (LIST (XSYM (QUOTE <))))
(MAK (QUOTE X) (LIST (XSYM (QUOTE >))))
(BBARGS U))))
EXPR)
(DEFPROP BBPPROP
(LAMBDA(ATM PROP V)
(COND ((NULL V) NIL)
(T (TTYMSG ATM)
(TERPRI)
(TERPRI)
(NEWLINE 8 NIL)
(PREX (COND ((NULL PROP) (CDR (BBEX V)))
((EQ PROP (QUOTE VALUE))
(BBVALDEF ATM (CDR V)))
(T (BBFUNDEF ATM (CADR V) (CDDR V) PROP)))
0
0)
(PRINC (QUOTE ⊗))
(TERPRI))))
EXPR)
(DEFPROP BBPPROPS
(LAMBDA(V)
(COND ((ATOM V)
(MAPC (FUNCTION (LAMBDA (X) (BBPPROP V X (GET V X))))
BBPROPS))
(T (BBPPROP NIL NIL V))))
EXPR)
(DEFPROP BBPROG
(LAMBDA(U)
(CONS 12
(MAK (QUOTE B)
(LIST (MAK (QUOTE X)
(LIST (XBOLD (QUOTE prog)) (XBLANK)))
(CONS 10000
(CONS (QUOTE E)
(CONS (BRACKET
(CONS 0 (BBVARS (CAR U)))
0)
(BBPROGA (CDR U)))))))))
EXPR)
(DEFPROP BBPROGA
(LAMBDA(U)
(COND ((NULL U) NIL)
((ATOM (CAR U))
(COND ((NULL (CDR U))
(LIST (MAK (QUOTE U) (LIST (LABL (CAR U))))))
(T
(CONS (MAK (QUOTE U)
(LIST (LABL (CAR U))
(CDR (BBEX (CADR U)))))
(BBPROGA (CDDR U))))))
(T (CONS (CDR (BBEX (CAR U))) (BBPROGA (CDR U))))))
EXPR)
(DEFPROP BBPROPS
(BBPROPS EXPR FEXPR VALUE)
VALUE)
(DEFPROP BBQUOTE
(LAMBDA(E)
(CONS
144
(MAK (QUOTE B) (LIST (MAK (QUOTE X) (LIST (XSYM (QUOTE $$))))
(BBQUOTEA E)
(MAK (QUOTE X) (LIST (XSYM (QUOTE $))))))))
EXPR)
(DEFPROP BBQUOTEA
(LAMBDA(E)
(COND
((ATOM (CAR E))
(MAK (QUOTE X)
(COND
((STRINGP (CAR E))
(COND
(PUB (LIST (XCONST (CAR E))))
(T
(LIST (XSYM (QUOTE /"))
(XCONST (CAR E))
(XSYM (QUOTE /"))))))
(T
(LIST (XCONST (CAR E)))))))
(T
(MAK (QUOTE B)
(LIST
(MAK (QUOTE X) (LIST (XSYM (QUOTE /())))
(MAK (QUOTE A)
(LIST
(MAK (QUOTE E) (BBQUOTEL (CAR E)))
(MAK (QUOTE X) (LIST (XSYM (QUOTE /))))))))))))
EXPR)
(DEFPROP BBQUOTEL
(LAMBDA(E)
(COND ((NULL (CDR E)) (LIST (BBQUOTEA E)))
((ATOM (CDR E))
(LIST (BBQUOTEA E)
(MAK (QUOTE B)
(LIST (MAK (QUOTE X)
(LIST (XBLANK) (XSYM (QUOTE /./ ))))
(BBQUOTEA (LIST (CDR E)))))))
(T
(CONS (MAK (QUOTE A)
(LIST (BBQUOTEA E)
(MAK (QUOTE X) (LIST (XBLANK)))))
(BBQUOTEL (CDR E))))))
EXPR)
(DEFPROP BBSELECTA
(LAMBDA(U)
(COND
((NULL (CDR U)) (LIST (BBEX (CAR U))))
(T
(CONS
(CONS
0
(MAK (QUOTE B)
(LIST
(MAK (QUOTE A)
(LIST (CDR (BBQUOTE (CAR U)))
(MAK (QUOTE X) (LIST (XBLANK)))))
(BRACKET (BBEXL (CDAR U)) 5))))
(BBSELECTA (CDR U))))))
EXPR)
(DEFPROP BBSELECTQ
(LAMBDA(U)
(COND ((LESSP (LENGTH U) 3) (BBFUN (QUOTE SELECTQ) (BBARGS U)))
(T
(BBFUN (QUOTE SELECTQ)
(CONS (BBEX (CAR U)) (BBSELECTA (CDR U)))))))
EXPR)
~The argument to BBLSPPUB is a list of elements each of which is a LISP atom
~with a non null VALUE, EXPR, or FEXPR prop or a nonatomic S-expression.
(DEFPROP BBLSPPUB
(LAMBDA(U)
(LINELENGTH 105)
(SETQ LINL 105)
(SETQ SINDENT SIN)
(SETQ FINDENT FIN)
(SETQ HINDENT HIN)
(SETQ FMAX MAXF)
(MAPC (FUNCTION BBPPROPS) U)
NIL)
EXPR)
(DEFPROP BBVALDEF
(LAMBDA(NAME VAL)
(CDR (BBEX (LIST (QUOTE SETQ) NAME (LIST (QUOTE QUOTE) VAL)))))
EXPR)
(DEFPROP BBVARS
(LAMBDA(U)
(MAK (QUOTE E)
(INPUNA
(MAK (QUOTE X) (LIST (XSYM (QUOTE /,/ ))))
(MAPCAR
(FUNCTION
(LAMBDA (V) (CONS 144 (MAK (QUOTE X) (LIST (XVAR V))))))
U))))
EXPR)
(DEFPROP BINOPB
(LAMBDA(ARGS V)
(CONS (CAR V)
(MAK (QUOTE E)
(INOPB
(MAK (QUOTE X)
(MAPCAR
(FUNCTION (LAMBDA (W) (XA (CAR W) (CADR W))))
(CDR V)))
(BBARGS ARGS)
(CAR V)))))
EXPR)
(DEFPROP BRACKET
(LAMBDA(U PREC)
(COND ((NOT (GREATERP (CAR U) PREC))
(MAK (QUOTE B)
(LIST (MAK (QUOTE X) (LIST (XSYM (QUOTE /[))))
(MAK (QUOTE A)
(LIST (CDR U)
(MAK (QUOTE X)
(LIST (XSYM (QUOTE /])))))))))
(T (CDR U))))
EXPR)
(DEFPROP CHARW
(CHARW . 20)
VALUE)
(DEFPROP CHVAL
(LAMBDA (Z) (COND ((NUMBERP Z) (PLUS Z 60)) (T (CHRVAL Z))))
EXPR)
(DEFPROP CLEARBB
(LAMBDA NIL
(MAPC (FUNCTION (LAMBDA (W) (REMPROP (CAR W) (QUOTE CARBB))))
CARBBLIST)
(SETQ CARBBLIST NIL)
(MAPC (FUNCTION (LAMBDA (W) (REMPROP (CAR W) (CADR W))))
PPROPLIST)
(SETQ PPROPLIST NIL))
EXPR)
(DEFPROP FIN
(FIN . 2)
VALUE)
(DEFPROP FSIZE
(LAMBDA(AT)
(FLATSIZEC AT))
EXPR)
(DEFPROP HIN
(HIN . 2)
VALUE)
(DEFPROP INOPB
(LAMBDA(P U PREC)
(COND ((NULL U) NIL)
(T (CONS (BRACKET (CAR U) PREC) (INOPBB P (CDR U) PREC)))))
EXPR)
(DEFPROP INOPBB
(LAMBDA(P U PREC)
(COND ((NULL U) NIL)
(T
(CONS (MAK (QUOTE B) (LIST P (BRACKET (CAR U) PREC)))
(INOPBB P (CDR U) PREC)))))
EXPR)
(DEFPROP INPUNA
(LAMBDA(P U)
(COND ((NULL U) NIL)
((NULL (CDR U)) (NCONS (CDAR U)))
(T
(CONS (MAK (QUOTE A) (LIST (CDAR U) P))
(INPUNA P (CDR U))))))
EXPR)
(DEFPROP LABL
(LAMBDA (U) (MAK (QUOTE X) (LIST (XSYM (QUOTE $$))
(XCONST U)
(XSYM (QUOTE :))
(XSYM (QUOTE $))
(XBLANK))))
EXPR)
(DEFPROP LCASE
(LAMBDA(L)
(SETQ LCFONTS
(APPEND
LCFONTS
(MAPCAR
(FUNCTION
(LAMBDA(W)
(READLIST (APPEND (QUOTE (B B)) (EXPLODE W)))))
L)))
L)
FEXPR)
(DEFPROP LINL
(LINL . 105)
VALUE)
(DEFPROP MAK
(LAMBDA (A U) (CONS (SUMLEN U) (CONS A U)))
EXPR)
(DEFPROP MAXF
(MAXF . 10)
VALUE)
(DEFPROP NEWLINE
(LAMBDA(N FLAG)
(PROG NIL
(COND (FLAG (PRINC (QUOTE ⊗))))
(TERPRI)
(SETQ IND N)
(SETQ POS 0)
A (COND ((EQ POS IND) (RETURN (PRINC (QUOTE ⊗⊗)))))
(PRINC (QUOTE / ))
(SETQ POS (ADD1 POS))
(GO A)))
EXPR)
(DEFPROP PARENS
(LAMBDA(LEFT RIGHT ARGS)
(MAK (QUOTE B)
(LIST LEFT
(MAK (QUOTE A)
(LIST (MAK (QUOTE E)
(INPUNA
(MAK (QUOTE X)
(LIST (XSYM (QUOTE /,/ ))))
ARGS))
RIGHT)))))
EXPR)
(DEFPROP PPLIST
(PPLIST (a/ BBBOLD (1 . qa/ ))
(d/ BBBOLD (1 . qd/ ))
(ad/ BBBOLD (2 . qad/ ))
(da/ BBBOLD (2 . qda/ ))
(dd/ BBBOLD (2 . qdd/ ))
(aa/ BBBOLD (2 . qaa/ ))
(aaa/ BBBOLD (3 . qaaa/ ))
(aad/ BBBOLD (3 . qaad/ ))
(ada/ BBBOLD (3 . qada/ ))
(add/ BBBOLD (3 . qadd/ ))
(daa/ BBBOLD (3 . qdaa/ ))
(dad/ BBBOLD (3 . qdad/ ))
(dda/ BBBOLD (3 . qdda/ ))
(ddd/ BBBOLD (3 . qddd/ ))
(aaaa/ BBBOLD (4 . qaaaa/ ))
(aaad/ BBBOLD (4 . qaaad/ ))
(aada/ BBBOLD (4 . qaada/ ))
(aadd/ BBBOLD (4 . qaadd/ ))
(adaa/ BBBOLD (4 . qadaa/ ))
(adad/ BBBOLD (4 . qadad/ ))
(adda/ BBBOLD (4 . qadda/ ))
(addd/ BBBOLD (4 . qaddd/ ))
(daaa/ BBBOLD (4 . qdaaa/ ))
(daad/ BBBOLD (4 . qdaad/ ))
(dada/ BBBOLD (4 . qdada/ ))
(dadd/ BBBOLD (4 . qdadd/ ))
(ddaa/ BBBOLD (4 . qddaa/ ))
(ddad/ BBBOLD (4 . qddad/ ))
(ddda/ BBBOLD (4 . qddda/ ))
(dddd/ BBBOLD (4 . qdddd/ ))
(at/ BBBOLD (2 . qat/ ))
(eq/ BBBOLD (2 . =/ ))
(equal/ BBBOLD (2 . =/ ))
(=/ BBBOLD (2 . =/ ))
(n/ BBBOLD (1 . qn/ ))
(if BBBOLD (2 . qif))
(then BBBOLD (4 . qthen))
(else BBBOLD (5 . qelse))
(else/ if BBBOLD (7 . qelse/ qif))
(prog BBBOLD (4 . qprog))
(go/ BBBOLD (2 . qgo/ ))
(T BBCONST (1 . qT))
(F BBCONST (1 . qF))
(NIL BBCONST (3 . qNIL))
($$ BBSYM (0 . $$))
($ BBSYM (0 . $))
)
VALUE)
(DEFPROP PRA
(LAMBDA(E IM R)
(PREX (CADDR E) IM (PLUS R (CAAR (CDDDR E))))
(PREX (CADDDR E) IM R))
EXPR)
(DEFPROP PREH
(LAMBDA(E IM R I2)
(PROG (IB IMM)
(SETQ IB (MAX I2 IM))
(SETQ IMM (PLUS IB SINDENT))
(SETQ E (CDDR E))
(COND ((NULL E) (RETURN NIL)))
A (PREX (CAR E) IMM (COND ((NULL (CDR E)) R) (T 0)))
(SETQ E (CDR E))
(COND ((NULL E) (RETURN NIL))
(T (ULINE IB (CAR E)) (GO A)))))
EXPR)
(DEFPROP PREX
(LAMBDA(E IM R)
(COND ((NOT (GREATERP (PLUS (CAR E) POS R) LINL)) (SIMPLEPRINT E))
(T
(SELECTQ (CADR E)
(E (PREH E IM R POS))
(H (PREH E IM R (PLUS POS HINDENT)))
(A (PRA E IM R))
((B U) (PRF E IM R LINL))
(F (PRF E IM R FMAX))
(T (PRT E IM R))
(PRINX E)))))
EXPR)
(DEFPROP PRF
(LAMBDA(E IM R M)
(COND ((OR (GREATERP (PLUS (CAADDR E) POS (MINUS IND)) M)
(GREATERP (PLUS (CAADDR E) POS) LINL))
(PROG (I)
(SETQ I (MAX IM (PLUS IND FINDENT)))
(PREX (CADDR E) (PLUS I SINDENT) 0)
(NEWLINE I T)
(PREX (CADDDR E) I R)))
(T (PREX (CADDR E) 0 0) (PREX (CADDDR E) IM R))))
EXPR)
(DEFPROP PRINTC
(LAMBDA (U) (TERPRI) (PRINC U))
EXPR)
(DEFPROP PRINX
(LAMBDA (E) (MAPC (FUNCTION PRINXX) (CDDR E)))
EXPR)
(DEFPROP PRINXX
(LAMBDA(E)
(COND ((AND (EQ POS IND) (EQ (CDR E) (QUOTE / ))) NIL)
(T (PRINC (CDR E))
(SETQ POS (PLUS POS (CAR E))))))
EXPR)
(DEFPROP PRT
(LAMBDA(E IM R)
((LAMBDA(I)
(COND ((NOT
(GREATERP (PLUS (CAADDR E) (CAADDR (CADDDR E)) POS)
LINL))
(PREX (CADDR E) 0 0)
(PREX (CADDR (CADDDR E)) 0 0)
(NEWLINE I T)
(PREX (CADDDR (CADDDR E)) I R))
(T (PREX (CADDR E) (PLUS I SINDENT) 0)
(NEWLINE I T)
(PREX (CADDDR E) (PLUS I SINDENT) R))))
(MAX IM (PLUS IND HINDENT))))
EXPR)
(DEFPROP PSIZE
(LAMBDA(U WIDTHS)
(COND ((NULL U) 0)
(T (PLUS (WIDTHS (CHVAL (CAR U))) (PSIZE (CDR U) WIDTHS)))))
EXPR)
(DEFPROP SETCARLIST
(LAMBDA(U)
(SETQ CARBBLIST U)
(MAPC (FUNCTION
(LAMBDA (W) (PUTPROP (CAR W) (CDR W) (QUOTE CARBB))))
U))
EXPR)
(DEFPROP SETPRINTPROPS
(LAMBDA(U)
(SETQ PPROPLIST U)
(MAPC (FUNCTION
(LAMBDA (W) (PUTPROP (CAR W) (CADDR W) (CADR W))))
U))
EXPR)
(DEFPROP SIMPLEPRINT
(LAMBDA(E)
(COND ((EQ (CADR E) (QUOTE X)) (PRINX E))
(T (MAPC (FUNCTION SIMPLEPRINT) (CDDR E)))))
EXPR)
(DEFPROP SIN
(SIN . 1)
VALUE)
(DEFPROP SMALL
(LAMBDA(C)
(COND ((NUMBERP C) C)
(T
((LAMBDA(X)
(COND ((AND (GREATERP X 100) (LESSP X 133))
(ASCII (PLUS X 40)))
(T C)))
(CHRVAL C)))))
EXPR)
(DEFPROP SMALLNAM
(LAMBDA (E) (MAKNAM (MAPCAR (FUNCTION SMALL) (EXPLODE E))))
EXPR)
(DEFPROP SUMLEN
(LAMBDA(U)
(COND ((NULL U) 0) (T (PLUS (CAAR U) (SUMLEN (CDR U))))))
EXPR)
(DEFPROP TTYMSG
(LAMBDA(MSG)
(PROG (CH) (SETQ CH (OUTC NIL NIL)) (PRINT MSG) (OUTC CH NIL)))
EXPR)
(DEFPROP ULINE
(LAMBDA(I E)
(COND ((EQ (CADR E) (QUOTE U))
(NEWLINE (MAX (DIFFERENCE I (CAADDR E)) 0) T))
(T (NEWLINE I T))))
EXPR)
(DEFPROP UNOP
(LAMBDA(ARGS V)
(CONS (CAR V)
(MAK (QUOTE F)
(LIST (MAK (QUOTE X)
(MAPCAR
(FUNCTION
(LAMBDA (W) (XA (CAR W) (CADR W))))
(CDR V)))
(BRACKET (BBEX (CAR ARGS)) 131)))))
EXPR)
(DEFPROP XA
(LAMBDA(SYMB AT)
(COND ((NUMBERP AT) (CONS (FSIZE AT ) AT))
((GET AT SYMB))
(T
(PROG (ATX)
(SETQ PRINTPROPS (CONS (CONS AT SYMB) PRINTPROPS))
(SETQ ATX
(COND ((MEMBER SYMB LCFONTS) (SMALLNAM AT))
(T AT)))
(RETURN
(PUTPROP
AT
(CONS (FSIZE ATX ) ATX)
SYMB))))))
EXPR)
(DEFPROP XBLANK
(LAMBDA NIL (XA (QUOTE BBSYM) (QUOTE / )))
EXPR)
(DEFPROP XBOLD
(LAMBDA (V) (XA (QUOTE BBBOLD) V))
EXPR)
(DEFPROP XCONST
(LAMBDA (V) (XA (QUOTE BBCONST) V))
EXPR)
(DEFPROP XSPACE
(LAMBDA(N)
(COND ((EQ N 0) NIL)
(T (PRINC (ASCII 177)) (PRINC (QUOTE α)) (PRINC (ASCII N)))))
EXPR)
(DEFPROP XSYM
(LAMBDA (V) (XA (QUOTE BBSYM) V))
EXPR)
(DEFPROP XVAR
(LAMBDA(E)
(COND ((OR (NULL E) (EQ E T) (NUMBERP E)) (XA (QUOTE BBCONST) E))
(T (XA (QUOTE BBVAR) E))))
EXPR)